;; test-codegen.scm: code generation test routines for r6rs-thrift
;; Copyright (C) 2012 Julian Graham

;; r6rs-thrift is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

#!r6rs

(import (rnrs))
(import (rnrs eval))
(import (srfi :64))
(import (thrift compile codegen)
	(thrift compile parse)
	(thrift compile resolve)
	(thrift private))

(test-begin "codegen")
(test-begin "const")

(test-group "simple"
  (let* ((const-definition 
	  (thriftc:make-const-definition 
	   "test-const"
	   (thrift:make-type-reference "string" #f thrift:field-type-string)
	   "test")))
    
    (let ((expressions (thriftc:generate-const 
			const-definition thriftc:default-naming-context))
	  (test-env (environment '(rnrs))))
      (for-each (lambda (exp) (eval exp test-env)) expressions)
      (test-assert (eval '(string? test-const) test-env))
      (test-assert (eval '(equal? test-const "test") test-env)))))

(test-end "const")
(test-begin "enum")

(test-group "simple"
  (let* ((enum-definition (thriftc:make-enum-definition 
			   "test-enum" 
			   (list (thriftc:make-enum-value-definition "ONE" 0)
				 (thriftc:make-enum-value-definition "TWO" 1)
				 (thriftc:make-enum-value-definition
				  "THREE" 2)))))
    
    (let ((expressions (thriftc:generate-enum
			enum-definition thriftc:default-naming-context))
	  (test-env (environment '(rnrs))))
      (for-each (lambda (exp) (eval exp test-env)) expressions)
      (test-assert (eval '(test-enum test-enum-ONE) test-env) 'test-enum-ONE)
      (test-assert (eval '(test-enum test-enum-TWO) test-env) 'test-enum-TWO)
      (test-assert (eval '(test-enum test-enum-THREE) test-env) 
		   'test-enum-THREE))))

(test-end "enum")
(test-begin "exception")

(test-group "simple"
  (let* ((exception-definition 
	  (thriftc:make-struct-definition 
	   "test-exception"
	   (list (thriftc:make-field-definition 
		  0 #t (thrift:make-type-reference 
			"string" #f thrift:field-type-string) "why" #f))
	   #t #f)))
    
    (let ((expressions (thriftc:generate-struct
			exception-definition thriftc:default-naming-context))
	  (test-env (environment '(rnrs))))
      (for-each (lambda (exp) (eval exp test-env)) expressions)
      (test-assert (eval '(record-type-descriptor? &test-exception) 
			 test-env)))))

(test-end "exception")
(test-begin "struct")

(test-group "simple"
  (let* ((struct-definition 
	  (thriftc:make-struct-definition 
	   "test-struct"
	   (list (thriftc:make-field-definition
		  0 #t (thrift:make-type-reference 
			"string" #f thrift:field-type-string) "foo" #f))
	   #f #f)))
    
    (let ((expressions (thriftc:generate-struct
			struct-definition thriftc:default-naming-context))
	  (test-env (environment '(rnrs))))
      (for-each (lambda (exp) (eval exp test-env)) expressions)
      (test-assert (eval '(record-type-descriptor? test-struct) test-env)))))

(test-end "struct")
(test-begin "union")

(test-group "simple"
  (let* ((union-definition 
	  (thriftc:make-struct-definition 
	   "test-union"
	   (list (thriftc:make-field-definition
		  0 #t (thrift:make-type-reference 
			"string" #f thrift:field-type-string) "foo" #f))
	   #f #t)))
    
    (let ((expressions (thriftc:generate-struct
			union-definition thriftc:default-naming-context))
	  (test-env (environment '(rnrs))))
      (for-each (lambda (exp) (eval exp test-env)) expressions)
      (test-assert (eval '(record-type-descriptor? test-union) test-env)))))

(test-group "single-field"
  (let* ((union-definition 
	  (thriftc:make-struct-definition 
	   "test-union"
	   (list (thriftc:make-field-definition
		  0 #t (thrift:make-type-reference 
			"string" #f thrift:field-type-string) "foo" #f)
		 (thriftc:make-field-definition
		  1 #t (thrift:make-type-reference 
			"string" #f thrift:field-type-string) "bar" #f))
	   #f #t)))
    
    (let ((expressions
	   (append (thriftc:generate-struct union-definition 
					    thriftc:default-naming-context)
		   (thriftc:generate-struct-builder
		    union-definition "thrift default" 
		    thriftc:default-naming-context)
		   (thriftc:generate-type-registration 
		    union-definition "thrift default" 
		    thriftc:default-naming-context)))	           
	  (test-env (environment '(rnrs) '(thrift private))))

      (for-each (lambda (exp) (eval exp test-env)) expressions)
      (eval '(define test-union-builder (make-test-union-builder)) test-env)
      (eval '(set-test-union-builder-foo! test-union-builder "str1") test-env)
      (eval '(set-test-union-builder-bar! test-union-builder "str2") test-env)
      (call/cc
       (lambda (cc)
	 (with-exception-handler
	  (lambda (condition)
	    (test-assert (thrift:condition? condition))
	    (cc))
	  (lambda ()
	    (eval '(test-union-builder-build test-union-builder) test-env)
	    (raise (make-assertion-violation)))))))))

(test-end "union")

(test-end "codegen")
